;;=======================================================
;; datarept.lsp
;; Copyright (c) 1991-99 by Forrest W. Young
;; This file contains methods for listing data and frequency tables
;; The frequency table generator does not work correctly and
;; has been shorted out of the program in version 7.0 (Fwy july 2002)
;;=======================================================

(defun data-listing ()
  (send current-data :report nil nil t nil)
  t)

(defun report-data ()
  (send current-data :report)
  t)

(defmeth mv-data-object-proto :report-data ()
  (if (not (eq *current-object* self)) (setcd self))
  (report-data))

(defmeth mv-data-object-proto :report 
           (&optional ok-types W 
                      (listing nil listing-opt) 
                      (freqs nil freqs-opt) 
                      (data-in nil) (labels-in))
"Method Args:  (&optional ok-types W listing freqs data)
Presents a LISTING of the data for the specified OK-TYPES (or all types if not specified). Includes the data object name, variable names and types and observation labels.  Prints frequency information for categorical variables when FREQS T. Only the active ok-types. Uses the entire data unless DATA is specified."
  (if (not (eq current-object self)) (setcd self))
  (if (not ok-types) (setf ok-types '(all)))
     (let* ((data (if data-in data-in (send self :active-data ok-types)))
            (n (length (send self :active-variables ok-types)))
            (m (/ (length data) n))
            (sizes (send self :array-dimensions))
            (ok? t)
            (first)
            (resp-var nil) 
            (freq-values)
            (header t)
            (list-data (if listing-opt listing
                           (member 0 (first (send self :summary-option-states)))))
            (show-freqs (if freqs-opt freqs
                        (member 4 (first (send self :summary-option-states)))))
            (dat-mat (matrix (list m n) data))
            (dat-lab (if labels-in labels-in (send self :active-labels)))
            (both (bind-columns dat-lab dat-mat)))
       (when (not w)
             (setf first t)
             (setf w (report-header (strcat (send self :name) " Data Summary Report") 
                                    :page t))
             (send self :data-info w))
       (when list-data
             (unless (and (send self :array) (equal (send self :data-type) "freq"))
                     (let ((doit t)
                           (nobs (send self :active-nobs))
                           (nvar (send self :active-nvar '(oktypes))))
                       (when (or (> nobs 500) (> nvar 30))
                             (setf doit 
                                   (yes-or-no-dialog 
                                    (format nil 
                                            "These data are large (there are~%~d observations and ~d variables).~%Do you want to see a listing?" nobs nvar))))
                       (when doit 
                             (display-string (format nil "~%_________________________________~2%") w)
                             (display-string (format nil   "Data Listing~2%") w)
                             (print-matrix-to-window 
                              dat-mat w 
                              :variable-types (send self :active-types ok-types)
                              :col-labels (send self :active-variables ok-types)
                              :row-labels dat-lab)));(send self :active-labels))))
                     ))
                                                                                                                                      #|FOLLOWING NOT WORKING RIGHT - FWY JULY 2002
       (when (or (and show-freqs (send self :array))
                 (and (send self :array) (equal (send self :data-type) "freq")))
             (setf freq-values (unique-values (combine (send self :freq-array))))
             (cond
               ((= (length freq-values) 1)
                (display-string (format nil "~%These data are balanced: All elements~%of all frequency tables are the same.~%The frequencies are each ~d."(first freq-values)) w))
               ((vectorp (send self :freq-array))
;(print "Vector type freq array")
                (setf freq-values (combine (send self :freq-array)))
                (display-string (format nil "~2%Frequencies:~%") w)
                (print-matrix-to-window 
                 (matrix (list 1 (length freq-values)) freq-values) w
                 :row-heading "Variable"
                 :column-heading "Categories"
                 :row-labels  (send self :active-variables '(category))
                 :column-labels (first (send self :array-labels)))
                )
               ((and (send self :array)
                     (or (= 1 (length sizes)) 
                         (= 1 (first  sizes))))
                (send self :print-array-to-window 
                      (send self :freq-array) w
                      :level-labels (send self :array-labels)
                      :way-labels (send self :array-variables)))
               (t
                (unless (equal (send self :data-type) "freq")
                        (send self :active-freq-array))
                (send self :print-array-to-window 
                      (send self :freq-array) w
                      :level-labels (send self :array-labels)
                      :way-labels (send self :array-variables))
                (when (= 2 (array-dimensionality (send self :freq-array)))
                      (display-string (format nil "~2%Cumulative Frequencies & Percents~%") w)
                      (send self :print-freq-table (send self :freq-array) 
                            w
                            :row-heading (first (send self :array-variables))
                            :column-heading (second (send self :array-labels))
                            :row-labels (first (send self :array-labels))))
                )))
               |#
       (if first (send w :fit-window-to-text))
       (send w :scroll 0 0)
       w))

(defmeth mv-data-object-proto :print-freq-table 
  (freq-matrix w &key row-labels (row-heading "Categories") column-heading)
               (if (not column-heading) 
                   (setf column-heading
                         (repeat "Variable" (second (array-dimensions freq-matrix)))))
    (mapcar #'(lambda (fvar var-name)
                (print-matrix-to-window
                 (bind-columns
                  fvar
                  (cumsum fvar)
                  (/ fvar (sum fvar))
                  (cumsum (/ fvar (sum fvar))))
                 w
                 :row-heading row-heading 
                 :row-labels row-labels 
                 :column-heading var-name
                 :column-labels (list "Frequency" "CumFreq" "Percent" "CumPcnt")))
            (column-list freq-matrix) column-heading))
